home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / wrolo-logic.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  9.3 KB  |  278 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         wrolo-logic.el
  4. ;; SUMMARY:      Performs logical retrievals on rolodex files
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     hypermedia, matching
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    13-Jun-89 at 22:57:33
  12. ;; LAST-MOD:     14-Apr-95 at 16:27:43 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1989-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;;
  22. ;;  INSTALLATION:
  23. ;;
  24. ;;   See also wrolo.el.  These functions are separated from wrolo.el since many
  25. ;;   users may never want or need them.  They can be automatically loaded when
  26. ;;   desired by adding the following to one of your Emacs init files:
  27. ;;
  28. ;;    (autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t)
  29. ;;
  30. ;;  FEATURES:
  31. ;;
  32. ;;   1.  One command, 'rolo-logic' which takes a logical search expression as
  33. ;;       an argument and displays any matching entries.
  34. ;;
  35. ;;   2.  Logical 'and', 'or', 'not', and 'xor' rolodex entry retrieval filter
  36. ;;       functions. They take any number of string or boolean arguments and
  37. ;;       may be nested.  NOTE THAT THESE FUNCTIONS SHOULD NEVER BE CALLED
  38. ;;       DIRECTLY UNLESS THE FREE VARIABLES 'start' and 'end' ARE BOUND
  39. ;;       BEFOREHAND.
  40. ;;
  41. ;;  EXAMPLE:
  42. ;;
  43. ;;     (rolo-logic (function
  44. ;;                   (lambda ()
  45. ;;                     (rolo-and
  46. ;;                        (rolo-not "Tool-And-Die")
  47. ;;                        "secretary"))))
  48. ;;
  49. ;;   would find all non-Tool-And-Die Corp. secretaries in your rolodex.
  50. ;;
  51. ;;   The logical matching routines are not at all optimal, but then most
  52. ;;   rolodex files are not terribly lengthy either.
  53. ;;
  54. ;; DESCRIP-END.
  55.  
  56. (require 'wrolo)
  57.  
  58. ;;;###autoload
  59. (defun rolo-logic (func &optional in-bufs count-only include-sub-entries
  60.                   no-sub-entries-out)
  61.   "Apply FUNC to all entries in optional IN-BUFS, display entries where FUNC is non-nil.
  62. If IN-BUFS is nil, 'rolo-file-list' is used.  If optional COUNT-ONLY is
  63. non-nil, don't display entries, return count of matching entries only.  If
  64. optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC will be applied across all
  65. sub-entries at once.  Default is to apply FUNC to each entry and sub-entry
  66. separately.  Entries are displayed with all of their sub-entries unless
  67. INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil.
  68. FUNC should use the free variables 'start' and 'end' which contain the limits
  69. of the region on which it should operate.  Returns number of applications of
  70. FUNC that return non-nil."
  71.   (interactive "xLogic function of no arguments, (lambda () (<function calls>): ")
  72.   (let ((obuf (current-buffer))
  73.     (display-buf (if count-only
  74.              nil
  75.                (prog1 (set-buffer (get-buffer-create rolo-display-buffer))
  76.              (setq buffer-read-only nil)
  77.              (erase-buffer)))))
  78.     (let ((result
  79.         (mapcar
  80.          (function
  81.           (lambda (in-bufs)
  82.          (rolo-map-logic func in-bufs count-only include-sub-entries
  83.                  no-sub-entries-out)))
  84.           (cond ((null in-bufs) rolo-file-list)
  85.             ((listp in-bufs) in-bufs)
  86.             ((list in-bufs))))))
  87.       (let ((total-matches (apply '+ result)))
  88.     (if (or count-only (= total-matches 0))
  89.         nil
  90.       (pop-to-buffer display-buf)
  91.       (goto-char (point-min))
  92.       (set-buffer-modified-p nil)
  93.       (setq buffer-read-only t)
  94.       (let ((buf (get-buffer-window obuf)))
  95.         (if buf (select-window buf) (switch-to-buffer buf))))
  96.     (if (interactive-p)
  97.         (message (concat (if (= total-matches 0) "No" total-matches)
  98.                  " matching entr"
  99.                  (if (= total-matches 1) "y" "ies")
  100.                  " found in rolodex.")))
  101.     total-matches))))
  102.  
  103. (defun rolo-map-logic (func rolo-buf &optional count-only
  104.                 include-sub-entries no-sub-entries-out)
  105.   "Apply FUNC to all entries in ROLO-BUF, write to buffer entries where FUNC is non-nil.
  106. If optional COUNT-ONLY is non-nil, don't display entries, return count of
  107. matching entries only.  If optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC
  108. will be applied across all sub-entries at once.  Default is to apply FUNC to
  109. each entry and sub-entry separately.  Entries are displayed with all of their
  110. sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT
  111. flag is non-nil.  FUNC should use the free variables 'start' and 'end' which
  112. contain the limits of the region on which it should operate.  Returns number
  113. of applications of FUNC that return non-nil."
  114.   (if (or (bufferp rolo-buf)
  115.       (if (file-exists-p rolo-buf)
  116.           (setq rolo-buf (find-file-noselect rolo-buf t))))
  117.       (let* ((display-buf (set-buffer (get-buffer-create rolo-display-buffer)))
  118.          (buffer-read-only))
  119.     (let ((hdr-pos) (num-found 0))
  120.       (set-buffer rolo-buf)
  121.       (goto-char (point-min))
  122.       (if (re-search-forward rolo-hdr-regexp nil t 2)
  123.           (progn (forward-line)
  124.              (setq hdr-pos (cons (point-min) (point)))))
  125.       (let* ((start)
  126.          (end)
  127.          (end-entry-hdr)
  128.          (curr-entry-level))
  129.         (while (re-search-forward rolo-entry-regexp nil t)
  130.           (setq start (save-excursion (beginning-of-line) (point))
  131.             next-entry-exists nil
  132.             end-entry-hdr (point)
  133.             curr-entry-level (buffer-substring start end-entry-hdr)
  134.             end (rolo-to-entry-end include-sub-entries curr-entry-level))
  135.           (let ((fun (funcall func)))
  136.         (or count-only 
  137.             (and fun (= num-found 0) hdr-pos
  138.              (append-to-buffer display-buf
  139.                        (car hdr-pos) (cdr hdr-pos))))
  140.         (if fun 
  141.             (progn (goto-char end)
  142.                (setq num-found (1+ num-found)
  143.                  end (if (or include-sub-entries
  144.                          no-sub-entries-out)
  145.                      end
  146.                        (goto-char (rolo-to-entry-end
  147.                             t curr-entry-level))))
  148.                (or count-only
  149.                    (append-to-buffer display-buf start end)))
  150.           (goto-char end-entry-hdr)))))
  151.       (rolo-kill-buffer rolo-buf)
  152.       num-found))
  153.     0))
  154.  
  155.  
  156. ;;
  157. ;; INTERNAL FUNCTIONS.
  158. ;;
  159.  
  160. ;; Do NOT call the following functions directly.
  161. ;; Send them as parts of a lambda expression to 'rolo-logic'.
  162.  
  163. (defun rolo-not (&rest pat-list)
  164.   "Logical <not> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  165. Each element may be t, nil, or a string."
  166.   (let ((pat))
  167.     (while (and pat-list
  168.         (or (not (setq pat (car pat-list)))
  169.             (and (not (eq pat t))
  170.              (goto-char start)
  171.              (not (search-forward pat end t)))))
  172.       (setq pat-list (cdr pat-list)))
  173.     (if pat-list nil t)))
  174.  
  175. (defun rolo-or (&rest pat-list)
  176.   "Logical <or> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  177. Each element may be t, nil, or a string."
  178.   (if (memq t pat-list)
  179.       t
  180.     (let ((pat))
  181.       (while (and pat-list
  182.           (or (not (setq pat (car pat-list)))
  183.               (and (not (eq pat t))
  184.                (goto-char start)
  185.                (not (search-forward pat end t)))))
  186.     (setq pat-list (cdr pat-list)))
  187.       (if pat-list t nil))))
  188.  
  189. (defun rolo-xor (&rest pat-list)
  190.   "Logical <xor> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  191. Each element may be t, nil, or a string."
  192.   (let ((pat)
  193.     (matches 0))
  194.     (while (and pat-list
  195.         (or (not (setq pat (car pat-list)))
  196.             (and (or (eq pat t)
  197.                  (not (goto-char start))
  198.                  (search-forward pat end t))
  199.              (setq matches (1+ matches)))
  200.             t)
  201.         (< matches 2))
  202.       (setq pat-list (cdr pat-list)))
  203.     (= matches 1)))
  204.  
  205. (defun rolo-and (&rest pat-list)
  206.   "Logical <and> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  207. Each element may be t, nil, or a string."
  208.   (if (memq nil pat-list)
  209.       nil
  210.     (let ((pat))
  211.       (while (and pat-list
  212.           (setq pat (car pat-list))
  213.           (or (eq pat t)
  214.               (not (goto-char start))
  215.               (search-forward pat end t)))
  216.     (setq pat-list (cdr pat-list)))
  217.       (if pat-list nil t))))
  218.  
  219. ;; Work with regular expression patterns rather than strings
  220.  
  221. (defun rolo-r-not (&rest pat-list)
  222.   "Logical <not> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  223. Each element may be t, nil, or a string."
  224.   (let ((pat))
  225.     (while (and pat-list
  226.         (or (not (setq pat (car pat-list)))
  227.             (and (not (eq pat t))
  228.              (goto-char start)
  229.              (not (re-search-forward pat end t)))))
  230.       (setq pat-list (cdr pat-list)))
  231.     (if pat-list nil t)))
  232.  
  233. (defun rolo-r-or (&rest pat-list)
  234.   "Logical <or> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  235. Each element may be t, nil, or a string."
  236.   (if (memq t pat-list)
  237.       t
  238.     (let ((pat))
  239.       (while (and pat-list
  240.           (or (not (setq pat (car pat-list)))
  241.               (and (not (eq pat t))
  242.                (goto-char start)
  243.                (not (re-search-forward pat end t)))))
  244.     (setq pat-list (cdr pat-list)))
  245.       (if pat-list t nil))))
  246.  
  247. (defun rolo-r-xor (&rest pat-list)
  248.   "Logical <xor> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  249. Each element may be t, nil, or a string."
  250.   (let ((pat)
  251.     (matches 0))
  252.     (while (and pat-list
  253.         (or (not (setq pat (car pat-list)))
  254.             (and (or (eq pat t)
  255.                  (not (goto-char start))
  256.                  (re-search-forward pat end t))
  257.              (setq matches (1+ matches)))
  258.             t)
  259.         (< matches 2))
  260.       (setq pat-list (cdr pat-list)))
  261.     (= matches 1)))
  262.  
  263. (defun rolo-r-and (&rest pat-list)
  264.   "Logical <and> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  265. Each element may be t, nil, or a string."
  266.   (if (memq nil pat-list)
  267.       nil
  268.     (let ((pat))
  269.       (while (and pat-list
  270.           (setq pat (car pat-list))
  271.           (or (eq pat t)
  272.               (not (goto-char start))
  273.               (re-search-forward pat end t)))
  274.     (setq pat-list (cdr pat-list)))
  275.       (if pat-list nil t))))
  276.  
  277. (provide 'wrolo-logic)
  278.